yy <- spTransform(master_buf, proj4string(bohemia::mop2))
xx <- spTransform(master_hull, proj4string(bohemia::mop2))

# Calculate areas of cores
xx@data$core_area_m2 <- geosphere::areaPolygon(x = xx)
yy@data$buffer_area_m2 <- geosphere::areaPolygon(x = yy)

# Get number of people in each cluster
np <- hh_level %>%
  dplyr::distinct(hh_id, .keep_all = TRUE) %>%
  group_by(cluster) %>%
  summarise(people_in_core = sum(n_members[status == 'core']),
            people_in_buffer = sum(n_members[status == 'buffer']),
            people = sum(n_members))

# Join everything together
xx@data <- left_join(xx@data, np)
yy@data <- left_join(yy@data, np)
yy@data <- left_join(yy@data, xx@data)
yy@data$buffer_area_m2 <- yy@data$buffer_area_m2 - yy@data$core_area_m2

MAP

pts <- hh_level %>%
  dplyr::distinct(hh_id, .keep_all = TRUE) 
l <- leaflet(width = '100%') %>%
  addProviderTiles(providers$Esri.WorldStreetMap) %>%
  addPolygons(data = yy,
               color = 'black',
              fillColor = 'grey',
              fillOpacity = 0.3,
              popup = popupTable(yy@data),
              label = paste0('Cluster number ', yy@data$cluster, 
                             '. People in buffer: ', yy@data$people_in_buffer,
                             '. Buffer area: ', 
                             round(yy@data$buffer_area_m2/1000000, 2), ' squared km')
               ) %>%
  addPolygons(data = xx,
              stroke = 0,
              fillColor = 'red',
              fillOpacity = 0.5,
              color = 'red',
              weight = 1,
              popup = popupTable(xx),
              label = paste0('Cluster number ', xx@data$cluster, '. People in core: ', xx@data$people_in_core,
                             '. Core area: ', round(xx@data$core_area_m2/1000000, 2), ' squared km')) %>%
  addCircleMarkers(data = pts, label = paste0('Household', pts$hh_id,  '. Number of people: ', pts$n_people), radius = 0.1)
l

Social science clusters

Map

# Define the social science clusters, since these can't be removed
social_science_clusters <- sort(unique(c(83, 49, 55, 36, 38, 156, 38, 39, 89, 91, 108, 129, 131, 131))) # per https://bohemia-corp.slack.com/archives/C02F7V9EA6P/p1637565208000600?thread_ts=1637530562.001600&cid=C02F7V9EA6P


# Get the hamlets / villages within each cluster
xx@data <- xx@data %>% left_join(cluster_level)

# Get study arm
xx@data <- xx@data %>% left_join(arm_assignments)


yys <- yy[yy@data$cluster %in% social_science_clusters,]
xxs <- xx[xx@data$cluster %in% social_science_clusters,]

pts <- hh_level %>%
  dplyr::distinct(hh_id, .keep_all = TRUE) %>%
  filter(cluster %in% social_science_clusters)

# cluster_level_2 <- pts %>%
#   group_by(cluster, code) %>%
#   tally


l <- leaflet(width = '100%') %>%
  addProviderTiles(providers$Esri.WorldImagery) %>%
  addPolygons(data = yys,
               color = 'black',
              fillColor = 'grey',
              fillOpacity = 0.3,
              popup = popupTable(yys@data),
              label = paste0('Cluster number ', yys@data$cluster, 
                             '. People in buffer: ', yys@data$people_in_buffer,
                             '. Buffer area: ', 
                             round(yys@data$buffer_area_m2/1000000, 2))
               ) %>%
  addPolygons(data = xxs,
              stroke = 0,
              fillColor = 'red',
              fillOpacity = 0.5,
              color = 'red',
              weight = 1,
              popup = popupTable(xxs),
              label = paste0('Cluster number ', xxs@data$cluster, '. People in core: ', xxs@data$people_in_core,
                             '. Core area: ', round(xxs@data$core_area_m2/1000000, 2), ' squared km. ', ' Hamlets: ', xxs@data$hamlets, '. Arm assignment: ', xxs@data$assignment)) %>%
  addCircleMarkers(data = pts, label = paste0('Household', pts$hh_id,  '. Number of people: ', pts$n_people), radius = 0.1)
l

Social science clusters table

px <- xxs@data %>%
   dplyr::select(cluster, hamlets, assignment)
knitr::kable(px)
cluster hamlets assignment
36 36 DEM;MHA 2
38 38 EDX;MIN;MNI 2
39 39 MNI 2
49 49 MUB;MUT 2
55 55 MUT 2
83 83 FRX;NDM;NZA 1
89 89 RBB;RIM 1
91 91 MIR;NXX;RIM 2
108 108 AAA;SXA 3
129 129 CHR;SIT 2
131 131 BAR;CAI;CUD;FNX;JOR 2
156 156 ACD;CHS;DDE;DFO;DRX;EDX 3

TABLE

pd <- yy@data %>%
  dplyr::select(cluster,
                people,
                people_in_buffer,
                people_in_core,
                buffer_area_m2,
                core_area_m2)
prettify(pd,
         nrows = nrow(pd),
         download_options = TRUE)